home *** CD-ROM | disk | FTP | other *** search
/ PC-Blue - MS DOS Public Domain Library / PC-Blue MS-DOS Public Domain Library - NYACC.iso / vol285 / printmar.bas (.txt) < prev    next >
Encoding:
GW-BASIC  |  1987-03-15  |  4.5 KB  |  161 lines
  1. 100  REM PRINTMAR Program.
  2. 110  REM Prints Detailed Marriage Information
  3. 120  REM Copyright (c) 1983 - 1987 by: Melvin O. Duke.
  4. 130  DEFINT A-Z
  5. 600  REM Titles
  6. 610  TITLE$ = "Print the Marriages File"
  7. 620  TITLE$ = TITLE$ + " ON DISPLAY"
  8. 700  REM Terminate if not called from the Menu
  9. 710  IF DD.MENU$ <> "" THEN 770
  10. 720  COLOR 7,0 : KEY ON : CLS : LOCATE 15,1
  11. 730  PRINT "Cannot run the"
  12. 740  PRINT TITLE$
  13. 750  PRINT "Program, unless selected from the MENU"
  14. 760  END
  15. 770  REM OK
  16. 1000  REM Produce the first screen
  17. 1010  KEY ON : CLS : KEY OFF
  18. 1020  REM Draw the outer double box
  19. 1030  R1 = 1 : C1 = 1 : R2 = 24 : C2 = 79 : GOSUB 1300
  20. 1040  REM Find the title location
  21. 1050  TITLE.POS = 40 - INT(LEN(TITLE$)/2)
  22. 1060  REM Draw the title box
  23. 1070  R1=3:C1=TITLE.POS-2:R2=6:C2=TITLE.POS+LEN(TITLE$)+1:GOSUB 1500
  24. 1080  REM Print the title
  25. 1090  LOCATE 4,TITLE.POS : PRINT TITLE$
  26. 1100  LOCATE 5,40-INT(LEN(VERSION$)/2) :  PRINT VERSION$;
  27. 1230  REM Draw the Copyright box
  28. 1240  R1 = 19 : C1 = 21 : R2 = 22 : C2 = 59 : GOSUB 1300
  29. 1250  REM Print the Copyright
  30. 1260  LOCATE 20,40-INT(LEN(COPY1$)/2) :  PRINT COPY1$;
  31. 1270  LOCATE 21,40-INT(LEN(COPY2$)/2) :  PRINT COPY2$;
  32. 1280  GOTO 1700
  33. 1300  REM subroutine to print a double box
  34. 1310  COLOR P
  35. 1320  FOR I = R1 + 1 TO R2 - 1
  36. 1330   LOCATE I, C1 : PRINT CHR$(186);
  37. 1340   LOCATE I, C2 : PRINT CHR$(186);
  38. 1350  NEXT I
  39. 1360   LOCATE R1, C1+1 : PRINT STRING$(C2-C1-1,205);
  40. 1390   LOCATE R2, C1+1 : PRINT STRING$(C2-C1-1,205);
  41. 1400   LOCATE R1, C1 : PRINT CHR$(201);
  42. 1410   LOCATE R1, C2 : PRINT CHR$(187);
  43. 1420   LOCATE R2, C1 : PRINT CHR$(200);
  44. 1430   LOCATE R2, C2 : PRINT CHR$(188);
  45. 1440  COLOR W
  46. 1450  RETURN
  47. 1500  REM subroutine to print a single box
  48. 1510  COLOR B
  49. 1520  FOR I = R1 + 1 TO R2 - 1
  50. 1530   LOCATE I, C1 : PRINT CHR$(179);
  51. 1540   LOCATE I, C2 : PRINT CHR$(179);
  52. 1550  NEXT I
  53. 1560   LOCATE R1, C1+1 : PRINT STRING$(C2-C1-1,196);
  54. 1590   LOCATE R2, C1+1 : PRINT STRING$(C2-C1-1,196);
  55. 1600   LOCATE R1, C1 : PRINT CHR$(218);
  56. 1610   LOCATE R1, C2 : PRINT CHR$(191);
  57. 1620   LOCATE R2, C1 : PRINT CHR$(192);
  58. 1630   LOCATE R2, C2 : PRINT CHR$(217);
  59. 1640  COLOR W
  60. 1650  RETURN
  61. 1700  REM ask user to press a key to continue
  62. 1710  LOCATE 25,1
  63. 1720  PRINT "Have Data Diskette(s) in Place, then Press any key to continue.";
  64. 1730  K$ = INKEY$ : IF K$ = "" THEN 1730
  65. 1740  KEY ON : CLS : KEY OFF
  66. 2000  REM PRINTMAR Program Starts Here
  67. 2010  OPEN DD.PERS$+"persfile" AS #1 LEN = 256
  68. 2020  FIELD 1, 5 AS F1$, 20 AS F2$, 30 AS F3$, 2 AS F4$, 5 AS F5$, 5 AS F6$, 5 AS F7$, 11 AS F8$, 18 AS F9$, 16 AS F10$, 16 AS F11$, 11 AS F12$, 18 AS F13$, 16 AS F14$, 16 AS F15$, 11 AS F16$, 18 AS F17$, 16 AS F18$, 16 AS F19$
  69. 2030  OPEN DD.MARR$+"marrfile" AS #2 LEN = 128
  70. 2040  FIELD 2, 5 AS M1$, 5 AS M2$, 5 AS M3$, 5 AS M4$, 11 AS M5$, 18 AS M6$, 16 AS M7$, 16 AS M8$, 45 AS M9$
  71. 2050  REM Determine User Wants
  72. 2060  KEY ON : CLS : KEY OFF : LOCATE 21,1
  73. 2070  PRINT "Enter the Marriage Number to be Printed (0 to quit), or 'all': ";
  74. 2080  LINE INPUT REPLY$
  75. 2090  IF REPLY$ = "0" THEN 2890
  76. 2100  K = 0
  77. 2110  GOTO 2160
  78. 2120  LPRINT TAB(10);"Print-out of Contents of the Marriages File"
  79. 2130  LPRINT TAB(10);DATE$,TIME$
  80. 2140  LPRINT
  81. 2150  RETURN
  82. 2160  IF LEFT$(REPLY$,1) = "a" OR LEFT$(REPLY$,1) = "A" THEN 2220
  83. 2170  K = 4
  84. 2180  I = VAL(REPLY$)
  85. 2190  IF I < 1 OR I > MAX.MAR THEN KEY ON : CLS : KEY OFF : LOCATE 20,1 : PRINT "Number is out of range"; : GOTO 2070
  86. 2200  GOSUB 2120
  87. 2210  GOSUB 2280 : GOTO 2060
  88. 2220  REM Read all records, and print the actual ones
  89. 2230  IF START.MAR < 1 THEN START.MAR = 1
  90. 2240  FOR I = START.MAR TO MAX.MAR
  91. 2250  LOCATE 22,1 : PRINT "Processing Record";I;
  92. 2260  GOSUB 2280
  93. 2270  GOTO 2820
  94. 2280  GET #2, I
  95. 2290  REM Extract information from the file for use
  96. 2300  T1! = CVS(M1$) : T1 = T1!
  97. 2310  IF T1 < 1 THEN 2810
  98. 2320  K = K + 1
  99. 2330  IF K MOD 5 = 1 THEN GOSUB 2120
  100. 2340  T2! = CVS(M2$) : T2 = T2!
  101. 2350  T3! = CVS(M3$) : T3 = T3!
  102. 2360  T4! = CVS(M4$)
  103. 2370  T5$ = M5$
  104. 2380  T6$ = M6$
  105. 2390  T7$ = M7$
  106. 2400  T8$ = M8$
  107. 2410  T9$ = M9$
  108. 2420  REM Obtain the name of the Male Spouse
  109. 2430  GET #1, T2
  110. 2440  REM Obtain the last and given names
  111. 2450  TEMP$ = F2$   'Male Spouse`s last name
  112. 2460  TMP$ = F2$
  113. 2470  GOSUB 2840
  114. 2480  TT2$ = TMP$
  115. 2490  TEMP$ = F3$   'Male Spouse's given names
  116. 2500  TMP$ = F3$
  117. 2510  GOSUB 2840
  118. 2520  TT3$ = TMP$
  119. 2530  REM Obtain the name of the Female Spouse
  120. 2540  GET #1, T3
  121. 2550  REM Obtain the last and given names
  122. 2560  TEMP$ = F2$   'Female Spouse`s last name
  123. 2570  TMP$ = F2$
  124. 2580  GOSUB 2840
  125. 2590  TT4$ = TMP$
  126. 2600  TEMP$ = F3$   'Female Spouse's given names
  127. 2610  TMP$ = F3$
  128. 2620  GOSUB 2840
  129. 2630  TT5$ = TMP$
  130. 2640  REM Now Print the Information
  131. 2650  LPRINT TAB(10);"Marriage Record-number : ";
  132. 2660  LPRINT USING "####"; T1
  133. 2670  LPRINT TAB(10);"Male Spouse            : ";
  134. 2680  LPRINT USING "####"; T2;
  135. 2690  LPRINT TAB(42); LEFT$(TT2$+", "+TT3$,37)
  136. 2700  LPRINT TAB(10);"Female Spouse          : ";
  137. 2710  LPRINT USING "####"; T3;
  138. 2720  LPRINT TAB(42); LEFT$(TT4$+", "+TT5$,37)
  139. 2730  LPRINT TAB(10);"Marriage-code          : ";T4!
  140. 2740  LPRINT TAB(10);"Marriage-date          : ";T5$
  141. 2750  LPRINT TAB(10);"Marriage-city          : ";T6$
  142. 2760  LPRINT TAB(10);"Marriage-county        : ";T7$
  143. 2770  LPRINT TAB(10);"Marriage-state         : ";T8$
  144. 2780  LPRINT TAB(10);"Comments: ";T9$
  145. 2790  LPRINT : LPRINT
  146. 2800  IF K MOD 5 = 0 THEN LPRINT FORM.FEED$;
  147. 2810  RETURN
  148. 2820  NEXT I
  149. 2830  GOTO 2890
  150. 2840  REM rtrim$ subroutine
  151. 2850  FOR J = 1 TO LEN(TEMP$)-1
  152. 2860   IF RIGHT$(TMP$,1)=" " THEN TMP$ = LEFT$(TMP$,LEN(TMP$)-1) ELSE J = LEN(TEMP$)-1
  153. 2870  NEXT J
  154. 2880  RETURN
  155. 2890  CLOSE #1
  156. 2900  KEY ON : CLS : KEY OFF : LOCATE 21,1
  157. 2910  PRINT "End of Program"
  158. 2920  IF (LEFT$(REPLY$,1) = "a" OR LEFT$(REPLY$,1) = "A") AND K MOD 5 <> 0 THEN 2930 ELSE 2940
  159. 2930  LPRINT FORM.FEED$;
  160. 2940  RUN DD.MENU$+"menu"
  161.